perm filename QDP.F4[MUS,LCS] blob sn#100964 filedate 1974-05-07 generic text, type T, neo UTF8
00100	C  ********** DISPLAY OUTPUT **********
01700		SUBROUTINE DPYQ
01800	C  ON DATADISK GRIDS MUST BE RESEST EACH TIME AROUND.
01920		COMMON/DP/IP(1),JDPY(2000)
02000		DIMENSION NUMS(5),ALF(4),ICA(4),ICB(4),ARY(9),IDOP(4,5)
02200	       DATA ICA/-110,90,90,-110/,IDOP/-108,406,168,406,
02300		1 -88,466,-88,346,  -24,376,-24,436,  40,376,40,436,
02400		1 104,376,104,436/, ICB/90,90,-110,-110/,ALF/'A','B','C','D'/
02500		1 , ARY/45H(' ARRAY F',I2,'(512); SEG(F',I2,');0  999')  /
02600	C  /DEG OR X/DIS OR Y/CEN OF CIRC X/CEN OF CIRCLE Y/(CALLS QUAD)/
02700		DATA NUMS/'1','25','50','75','100'/
02800	CC	CALL DDCLR
02900		CALL CLRPOG(1)
03300		CALL DPYSET(1,JDPY,2000)
03400		CALL DPYBRT(2)
03500	
03600	1	IT=-260
03700		IB=-495
03800	999	I=0
03900		CALL TYPLOC(IT,IB)
04000		I=230
04100		J=506
04200		LB=250
04300		DO 5 K=1,2
04400		L=255
04500		IB=236
04600		JB=456
04700		DO 6 M=1,2
04800		CALL ALINE(I,L,J,L)
04900	C   HORIZANTAL LINES
05000		CALL ALINE(LB,IB,LB,JB)
05100	C   VERTICAL LINES
05200		DO 7 KB=LB+192,LB+64,-64
05300	7	CALL ALINE(KB,L,KB,IB)
05400	C   SPACE MARKERS ON FUNC DPYS.
05500		IF(K.NE.1.OR.M.NE.1)GO TO 66
05600	C  NEXT SETS UP DOPPLER DPY GRID
05700		DO 55 KB=1,5
05800	55	CALL ALINE(IDOP(1,KB),IDOP(2,KB),IDOP(3,KB),IDOP(4,KB))
05900	66	L=-441
06000		IB=-460
06100	6	JB=-240
06200		LB=-466
06300		I=-486
06400	5	J=-210
06500	
06600		CALL ALINE(-200,-200,200,200)
06700		CALL ALINE(-200,200,200,-200)
06800	C   MARKS LISTENER POS.
06900	
07000		A=4.
07100		L=0
07200		I=141.4
07300		J=-1
07400	140	IB=141.4*SIND(A)
07500		JB=141.4*COSD(A)
07600		IF(J.GE.0)GO TO 141
07700		CALL ALINE(L,I,IB,JB)
07800	141	A=A+4.
07900		J=J+1
08000		IF(J.EQ.2)J=-1
08100		L=IB
08200		I=JB
08300		IF(A.LT.360.)GO TO 140
08400	C   THE SPEAKER CIRCLE.  MAKES DASHES, EVERY 3RD SEG.
08500	
08600		CALL DPYBRT(5)
08700		CALL DPYBIG(6)
08800		DO 14 K=1,4
08900	14	CALL DPYTXT(ICA(K),ICB(K),ALF(K),1)
09000	10	CALL DPYOUT(1)
09200		END
09300	
09400		SUBROUTINE ZERO(F)
09500		DIMENSION F(1)
09600		DO 1 K=1,512
09700	1	F(K)=0
09900		END